Cream of the Crop 20/Cream of the Crop 20 (Terry Blount) (1996).iso/program/vol15n11.zip/TBWIZ.ZIP/SAVEFORM.FRM

Text File | 1996-02-24 | 9KB | 321 lines

VERSION 4.00
Begin VB.Form tbSaveForm
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "Save Toolbar"
   ClientHeight    =   1590
   ClientLeft      =   2850
   ClientTop       =   3315
   ClientWidth     =   4515
   ControlBox      =   0   'False
   Height          =   1995
   Left            =   2790
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   1590
   ScaleWidth      =   4515
   ShowInTaskbar   =   0   'False
   Top             =   2970
   Width           =   4635
   Begin VB.CommandButton Command2
      Caption         =   "Cancel"
      Height          =   325
      Left            =   3480
      TabIndex        =   5
      Top             =   720
      Width           =   975
   End
   Begin VB.CommandButton Command1
      Caption         =   "&Save"
      Height          =   325
      Left            =   3480
      TabIndex        =   4
      Top             =   240
      Width           =   975
   End
   Begin VB.Frame Frame1
      Caption         =   "Select Toolbar:"
      Height          =   1335
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   3135
      Begin VB.ComboBox Combo1
         Height          =   315
         Index           =   0
         Left            =   1065
         TabIndex        =   2
         Text            =   "Combo1"
         Top             =   480
         Width           =   1815
      End
      Begin VB.Label Label2
         BorderStyle     =   1  'Fixed Single
         Height          =   275
         Left            =   1080
         TabIndex        =   6
         Top             =   840
         Visible         =   0   'False
         Width           =   1815
      End
      Begin VB.Label Label1
         AutoSize        =   -1  'True
         Caption         =   "ImageList:"
         Height          =   195
         Index           =   1
         Left            =   240
         TabIndex        =   3
         Top             =   860
         Visible         =   0   'False
         Width           =   720
      End
      Begin VB.Label Label1
         AutoSize        =   -1  'True
         Caption         =   "Toolbar:"
         Height          =   195
         Index           =   0
         Left            =   360
         TabIndex        =   1
         Top             =   510
         Width           =   585
      End
   End
   Begin MSComDlg.CommonDialog CommonDialog1
      Left            =   3720
      Top             =   1080
      _Version        =   65536
      _ExtentX        =   847
      _ExtentY        =   847
      _StockProps     =   0
      CancelError     =   -1  'True
      DefaultExt      =   "*.tbr"
      DialogTitle     =   "Save Toolbar"
      Filter          =   "*.tbr | Toolbars"
   End
End
Attribute VB_Name = "tbSaveForm"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit
DefInt A-Z

Function GetImageListName$()
GetImageListName$ = ""
'___setup vars
Dim CurrFormName$, CurrFormFiles$(1)
Dim i%, ii%
'___get form file names
With gobjIDEAppInst.ActiveProject
    CurrFormName$ = .ActiveForm.Properties.Item("Name")
    With .Components
        For i% = 0 To .Count - 1
            If .Item(i%).Name = CurrFormName$ Then CurrFormFiles$(0) = .Item(i%).FileNames(0)
        Next
    End With
End With
If CurrFormFiles$(0) = "" Or (Len(CurrFormFiles$(0)) = 0) Then
    Alert "Save form file first!"
    Exit Function
End If

'___more vars...
Dim Source$
Dim linetest$
Dim tbTest$
Source$ = CurrFormFiles$(0)
Const icTest$ = "ImageList"
tbTest$ = "Toolbar " & Combo1(0)
'___get imagelist name
Open Source$ For Input As #2
    Do While Not EOF(2)
        Line Input #2, linetest$
        If InStr(linetest$, tbTest$) > 0 Then
           '___we found the toolbar
            Do
              Line Input #2, linetest$
              linetest$ = Trim$(linetest$)
              If Left$(linetest$, 9) = icTest$ Then
              '___we found the imagelist
               ii% = InStr(linetest$, Chr$(34))
               If ii% > 0 Then
                    linetest$ = Mid$(linetest$, ii% + 1)
                    ii% = InStr(linetest$, Chr$(34))
                    GetImageListName$ = Left$(linetest$, ii% - 1)
                End If
                Close #2
                Exit Function
            End If
            Loop
         End If
     Loop
Close #2
End Function


Function SaveTB() As Integer
'___setup vars
Dim ProjectFilename$, ProjectDirty As Boolean
Dim CurrFormName$, CurrFormFiles$(1)
Dim i%, ii%
Dim success As Boolean
'___get form file names
With gobjIDEAppInst.ActiveProject
    CurrFormName$ = .ActiveForm.Properties.Item("Name")
    With .Components
        For i% = 0 To .Count - 1
            If .Item(i%).Name = CurrFormName$ Then
                CurrFormFiles$(0) = .Item(i%).FileNames(0)
                CurrFormFiles$(1) = .Item(i%).FileNames(1)
            End If
        Next
    End With
End With
If CurrFormFiles$(0) = "" Or (Len(CurrFormFiles$(0)) = 0) Then
    Alert "Save form file first!"
    SaveTB = -1
    Exit Function
End If

'___get name of target TBR file from user
On Error Resume Next
CommonDialog1.ShowSave
If Err = cdlCancel Then SaveTB = 0: Exit Function
On Error GoTo 0
gfnameTBFile = CommonDialog1.FileName
Screen.MousePointer = HOURGLASS

'___more vars...
Dim Source$
Source$ = CurrFormFiles$(0)
Dim linetest$
Dim Targ$
Dim tbEvent$
Dim icTest$, tbTest$
Dim Terminator$
'icTest$ = "ImageList " & Label2 '& Combo1(1)
Const imagelistID = "ImageList"
tbTest$ = "Toolbar " & Combo1(0)
tbEvent$ = Combo1(0) & "_"
Targ$ = ExtractFilePath$(gfnameTBFile) + ExtractFileRoot(gfnameTBFile) + ".tbr"
Terminator$ = "End"

'___first get imagelist name
Open Source$ For Input As #2
    Do While Not EOF(2)
        Line Input #2, linetest$
        If InStr(linetest$, tbTest$) > 0 Then
           '___we found the toolbar
            Do
              Line Input #2, linetest$
              linetest$ = Trim$(linetest$)
              If Left$(linetest$, 9) = imagelistID Then
              '___we found the imagelist
               ii% = InStr(linetest$, Chr$(34))
               If ii% > 0 Then
                    linetest$ = Mid$(linetest$, ii% + 1)
                    ii% = InStr(linetest$, Chr$(34))
                    icTest$ = "ImageList " & Left$(linetest$, ii% - 1)
                End If
                Exit Do
            End If
            Loop
            If Len(icTest$) Then Exit Do
         End If
  Loop
Close #2



'___now copy controls from frm to tbr file
Open Targ$ For Output As #1
Open Source$ For Input As #2
    Do While Not EOF(2)
        Line Input #2, linetest$
        If (InStr(linetest$, icTest$) > 0) Or (InStr(linetest$, tbTest$) > 0) Then
           '___we found the toolbar or imagelist
            Print #1, linetest$
            Do
              Line Input #2, linetest$
              Print #1, linetest$
            Loop Until Trim$(linetest$) = Terminator$
         End If
     Loop
Close #2
'___now copy the toolbar's event handlers
Terminator$ = "End Sub"
Print #1, "TB_EVENTS"
Open Source$ For Input As #2
    Do While Not EOF(2)
        Line Input #2, linetest$
        If InStr(linetest$, tbEvent$) > 0 Then
            '___we found a toolbar event handler
            Print #1, linetest$
            Do
              Line Input #2, linetest$
              Print #1, linetest$
            Loop Until Trim$(linetest$) = Terminator$
        End If
    Loop
Close #2
Close #1

'___copy frx file
Targ$ = ExtractFilePath$(gfnameTBFile) + ExtractFileRoot(gfnameTBFile) + ".frx"
FileCopy ExtractFilePath$(Source$) + ExtractFileRoot(Source$) + ".frx", Targ$
SaveTB = 1
End Function

Private Sub Combo1_Click(Index As Integer)
'Label2 = GetImageListName$()
End Sub


Private Sub Command1_Click()
Select Case SaveTB()
Case -1 'form hasn't been saved